home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2005 June / PCpro_2005_06.ISO / files / opensource / syntexteditor / synsetup-2.1.0.46.exe / {app} / templates / Pascal / OpenGL.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2003-08-13  |  3.7 KB  |  155 lines
  1. {Description: OpenGL Program|}
  2. {
  3.   Created: {$DateTime} by {$UserName}
  4.  
  5.   $Id: OpenGL.pas,v 1.1.2.3 2003/08/13 00:38:45 neum Exp $
  6. }
  7.  
  8. { Translated from the OpenGL Template from Dev-C++ }
  9. { This file compiles with FreePascal 1.0.6 and Delphi 5, and maybe some others }
  10. program {$FileTitleNoExt};
  11. {$APPTYPE GUI}
  12.  
  13. uses
  14.   Windows,
  15.   SysUtils,
  16. {$ifdef FPC}
  17.   OpenGL32,
  18.   gl
  19. {$else}
  20.   Messages,
  21.   OpenGL
  22. {$endif}
  23.   ;
  24.  
  25. const
  26.   AppTitle = '{$FileTitleNoExt}';
  27.   ClassName = '{$FileTitleNoExt}WindowClass';
  28.  
  29. var
  30.   Msg: TMsg;
  31.   Handle: HWND;         { Handle of the Mainwindow }
  32.   bQuit: boolean;
  33.   gHDC: HDC;
  34.  
  35. procedure DisableOpenGL(hWnd: HWND; hDC: HDC; hRC: HGLRC);
  36. begin
  37.   wglMakeCurrent(0, 0);
  38.   wglDeleteContext(hRC);
  39.   ReleaseDC(hWnd, hDC);
  40. end;
  41.  
  42. procedure EnableOpenGL(hWnd: HWND; var hDC: HDC; var hRC: HGLRC);
  43. var
  44.   pfd: PIXELFORMATDESCRIPTOR;
  45.   iFormat: integer;
  46. begin
  47.   { get the device context (DC) }
  48.   hDC := GetDC(hWnd);
  49.  
  50.   { set the pixel format for the DC }
  51.   FillChar(pfd, SizeOf(pfd), 0);
  52.   pfd.nSize := SizeOf(pfd);
  53.   pfd.nVersion := 1;
  54.   pfd.dwFlags := PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL or PFD_DOUBLEBUFFER;
  55.   pfd.iPixelType := PFD_TYPE_RGBA;
  56.   pfd.cColorBits := 24;
  57.   pfd.cDepthBits := 16;
  58.   pfd.iLayerType := PFD_MAIN_PLANE;
  59. {$ifdef FPC}
  60.   iFormat := ChoosePixelFormat(hDC, pfd);
  61. {$else}
  62.   iFormat := ChoosePixelFormat(hDC, @pfd);
  63. {$endif}
  64.   SetPixelFormat(hDC, iFormat, @pfd);
  65.  
  66.   { create and enable the render context (RC) }
  67.   hRC := wglCreateContext(hDC);
  68.   wglMakeCurrent(hDC, hRC);
  69. end;
  70.  
  71. function WndProc(HWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
  72. begin
  73.   { Window procedure, add here your message handlers }
  74.   case Msg of
  75.     WM_DESTROY:
  76.       begin
  77.         bQuit := true;
  78.         PostQuitMessage(0);
  79.         WndProc := 0;
  80.       end;
  81.     else
  82.       WndProc := DefWindowProc(HWnd, Msg, WParam, LParam);
  83.   end;
  84. end;
  85.  
  86. procedure ProcessMessages;
  87. var
  88.   theta: double;
  89. begin
  90.   { Wait for Messages }
  91.   theta := 0.0;
  92.   while not bQuit do begin
  93.     if PeekMessage(Msg, Handle, 0, 0, PM_REMOVE) then begin
  94.       if Msg.message = WM_QUIT then
  95.         bQuit := true
  96.       else begin
  97.         TranslateMessage(Msg);
  98.         DispatchMessage(Msg);
  99.       end;
  100.     end else begin
  101.       glClearColor(0.0, 0.0, 0.0, 0.0);
  102.       glClear(GL_COLOR_BUFFER_BIT);
  103.  
  104.       glPushMatrix;
  105.       glRotatef(theta, 0.0, 0.0, 1.0);
  106.       glBegin(GL_TRIANGLES);
  107.       glColor3f(1.0, 0.0, 0.0);   glVertex2f(0.0, 1.0);
  108.       glColor3f(0.0, 1.0, 0.0);   glVertex2f(0.87, -0.5);
  109.       glColor3f(0.0, 0.0, 1.0);   glVertex2f(-0.87, -0.5);
  110.       glEnd;
  111.       glPopMatrix;
  112.  
  113.       SwapBuffers(gHDC);
  114.  
  115.       theta := theta + 1.0;
  116.       Sleep(1);
  117.     end;
  118.   end;
  119. end;
  120.  
  121. var
  122.   { Global Variables }
  123.   WClass: TWndClass;
  124.   gHRC: HGLRC;
  125.  
  126. begin
  127.   with WClass do begin
  128.     Style := CS_HREDRAW or CS_VREDRAW;
  129.     lpfnWndProc := @WndProc;
  130.     cbClsExtra := 0;
  131.     cbWndExtra := 0;
  132.     hInstance := HInstance;
  133.     hIcon := LoadIcon(0, IDI_APPLICATION);
  134.     hCursor := LoadCursor(0, IDC_ARROW);
  135.     hbrBackground := COLOR_WINDOW + 1;
  136.     lpszMenuName := PChar(AppTitle);
  137.     lpszClassName := PChar(ClassName);
  138.   end;
  139.   RegisterClass(WClass);
  140.   Handle := CreateWindow(PChar(ClassName), PChar(AppTitle), WS_OVERLAPPEDWINDOW, 0,
  141.     0, 200, 200, 0, 0, HInstance, nil);
  142.   if Handle = 0 then begin
  143.     MessageBox(0, 'Unable to create Window.', PChar(AppTitle), MB_ICONSTOP + MB_OK);
  144.   end else begin
  145.     EnableOpenGL(Handle, gHDC, gHRC);
  146.     bQuit := false;
  147.     ShowWindow(Handle, SW_SHOW);
  148.     ProcessMessages;
  149.     DisableOpenGL(Handle, gHDC, gHRC);
  150.  
  151.     DestroyWindow(Handle);
  152.   end;
  153. end.
  154.  
  155.